home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / seditBind.tcl.z / seditBind.tcl
Text File  |  2002-07-08  |  24KB  |  933 lines
  1. # seditBind.tcl
  2. #
  3. # Support routines to define a set of consistent editing bindings for
  4. # Text and Entry widgets
  5. #
  6. # Copyright (c) 1993 Xerox Corporation.
  7. # Use and copying of this software and preparation of derivative works based
  8. # upon this software are permitted. Any distribution of this software or
  9. # derivative works must comply with all applicable United States export
  10. # control laws. This software is made available AS IS, and Xerox Corporation
  11. # makes no warranty about the software, its performance or its conformity to
  12. # any specification.
  13.  
  14. # Because we override Entry and Text bindings, make sure we load those first
  15. # By auto-loading these procedures we also fault in the global Text and
  16. # Entry bindings done by the Tk library code.
  17.  
  18. auto_load tkEntryButton1
  19. auto_load tkTextButton1
  20.  
  21. proc Sedit_BindInit {} {
  22.     global sedit exmh
  23.  
  24.     foreach editproc [option get . sedit_editprocs {}] {
  25.     set sedit(key,$editproc) [option get . sedit_key_$editproc {}]
  26.     }
  27.     Preferences_Resource sedit(pasteSetsInsert) sedit_pasteSetsInsert 1
  28.     Preferences_Resource sedit(typeKillsSel) sedit_typeKillsSel 1
  29.     Preferences_Resource sedit(scrollButton) sedit_scrollButton Middle
  30.  
  31.     # Don't really need sedit-bindings and local.sedit-bindings anymore
  32.     # with the use of resources
  33.     set sedit(defaultfile) $exmh(library)/sedit-bindings
  34.     set sedit(localfile)   $exmh(library)/local.sedit-bindings
  35.     set sedit(dotfile)     ~/.exmh/exmhsedit
  36.  
  37.     SeditReadPref
  38.     Sedit_ClassBindings
  39.     SeditComposedKeyBindings
  40. }
  41. proc SeditReadPref {} {
  42.     global sedit
  43.  
  44.     foreach file {defaultfile localfile dotfile} {
  45.     if [file exists $sedit($file)] {
  46.         if [catch {uplevel #0 source [glob $sedit($file)]} msg] {
  47.         Exmh_Status "Error in $sedit($file): $msg"
  48.         }
  49.     }
  50.     }
  51. }
  52. proc SeditBind { class key body } {
  53.     global sedit
  54.     if [catch {
  55.     foreach seq $sedit(key,$key) {
  56.         if {$seq == {}} {
  57.         continue
  58.         }
  59.         bind $class $seq $body
  60.         # Double-bind Meta-key and Escape-key
  61.         if [regexp {<Meta-(.*)>} $seq match letter] {
  62.         bind $class <Escape><$letter> $body
  63.         }
  64.         # Make leading keystroke harmless
  65.         if [regexp {(<.+>)<.+>} $seq match prefix] {
  66.         bind $class $prefix break
  67.         }
  68.     }
  69.     } err] {
  70.     if ![info exists sedit(key,$key)] {
  71.         Exmh_Debug "Bind $class $key: $err"
  72.     } else {
  73.         Exmh_Debug "Bind $class $key $sedit(key,$key): $err"
  74.     }
  75.     }
  76. }
  77. proc Sedit_TagBindings { w tag } {
  78.     $w tag bind $tag <Button-1>        {WidgetTextSelBegin %W %x %y char}
  79.     $w tag bind $tag <Double-Button-1>    {WidgetTextSelBegin %W %x %y word}
  80.     $w tag bind $tag <Triple-Button-1>    {WidgetTextSelBegin %W %x %y line}
  81.     $w tag bind $tag <Any-B1-Motion>    {WidgetTextSelMotion %W %x %y}
  82.     $w tag bind $tag <Any-ButtonRelease-1>    {WidgetTextSelDone %W}
  83. }
  84. proc SeditTextBindings { draft t } {
  85.     global sedit quote
  86.     # Define binding tags:
  87.     # SeditText - simple editor commands and data entry
  88.     # TScroll - drag scrolling
  89.     # TSelect - text selection
  90.     # $t - send message binding
  91.     # toplevel - not used
  92.     # all - not used because it has focus-change bindings on <Tab>
  93.     bindtags $t [list $t SeditText TSelect TScroll [winfo toplevel $t]]
  94.     SeditBind $t sendMsg "SeditSend {$draft} {$t} 0 ; break"
  95.     SeditBind Entry sendMsg { }
  96.     SeditBind $t abortMsg "SeditAbort {$draft} {$t} ; break"
  97.     SeditBind Entry abortMsg { }
  98.     SeditBind $t quoteMsg "SeditInsertFile {$draft} {$t} {$quote(filename)} ; break"
  99.     SeditBind Entry quoteMsg { }
  100.  
  101.     # redisplay debug loggin
  102.     if {[info commands log_dump] == "log_dump"} {
  103.     bind $t <Key> {log "Key %A %K"}
  104.     bind $t <Enter> {log "Enter %W"}
  105.     bind $t <Leave> {log "Leave %W"}
  106.     bind $t <ButtonPress> {log "ButtonPress %W"}
  107.     bind $t <ButtonRelease> {log "ButtonRelease %W"}
  108.     }
  109. }
  110. proc Sedit_ClassBindings { } {
  111.     global sedit
  112.  
  113.     foreach class {SeditText Entry} {
  114.     foreach b [bind $class] {
  115.         bind $class $b ""
  116.     }
  117.     }
  118.     # This is needed because there are no Text bindings at this
  119.     # point - they have not been faulted in yet from the library -
  120.     # So erasing them now doesn't help.  We use an alternate class.
  121.     set tclass SeditText
  122.  
  123.     # Modification bindings
  124.  
  125.     bind $tclass <Return> {
  126.     SeditKill?Sel %W
  127.     Text_Insert %W insert \n; %W yview -pickplace insert
  128.     SeditDirty %W
  129.     }
  130.     bind $tclass <Tab> {
  131.     if [%W compare insert <= hlimit] {
  132.         Text_MoveInsert %W insert+1line
  133.         Text_MoveInsert %W "insert lineend"
  134.     } else {
  135.         Text_Insert %W insert \t
  136.         %W yview -pickplace insert
  137.         SeditDirty %W
  138.     }
  139.     }
  140.     bind $tclass <Double-Tab> {
  141.     if [%W compare insert <= hlimit] {
  142.         Text_MoveInsert %W hlimit+1line
  143.     } else {
  144.         Text_Insert %W insert %A; %W yview -pickplace insert
  145.         SeditDirty %W
  146.     }
  147.     }
  148.     bind $tclass <Control-i> [bind $tclass <Tab>]
  149.  
  150.     # These bindings ensure that unbound control, meta, and escape
  151.     # sequences don't do anything.
  152.     foreach ignore {<Escape> <Control-Key> <Meta-Key>} {
  153.     bind $tclass $ignore { } ;# no-op
  154.     bind Entry $ignore { } ;# no-op
  155.     }
  156.  
  157.     SeditBind $tclass selpaste {
  158.     Text_Yank %W
  159.     SeditDirty %W
  160.     }
  161.     SeditBind Entry selpaste {
  162.     if [catch {%W insert insert [selection get]}] {
  163.         if [catch {%W insert insert [selection get -selection CLIPBOARD]}] {
  164.         catch {%W insert insert [cutbuffer get]}
  165.         }
  166.     }
  167.     }
  168.  
  169.  
  170.     # When <Dcircumflex_accent> is pressed, wait for one char and insert the
  171.     # compose key ^ <letter>
  172.     SeditBind $tclass <Dcircumflex_accent> {
  173.     bind SeditText <Any-Key> {
  174.         if {"%%A" != "{}"} {
  175.         SeditComposedKey %%W "^" "%%A"
  176.         }
  177.     }
  178.     }
  179.  
  180.     # When <Ddiaeresis> is pressed, wait for one char and insert the
  181.     # compose key " <letter>
  182.     SeditBind $tclass <Ddiaeresis> {
  183.     bind SeditText <Any-Key> {
  184.         if {"%%A" != "{}"} {
  185.         SeditComposedKey %%W "\"" "%%A"
  186.         }
  187.     }
  188.     }
  189.  
  190.     # when the compose char is pressed, wait for 2 chars
  191.     # (the first may be part of the composechar event)
  192.     SeditBind $tclass composechar {
  193.     bind SeditText <Any-Key> {
  194.         if {"%%A" != "{}"} {
  195.         if {"%A" == "{}"} {
  196.             bind SeditText <Any-Key> {
  197.             if {"%%%%A" != "{}"} {
  198.                 SeditComposedKey %%%%W "%%A" "%%%%A"
  199.             }
  200.             }
  201.         } else {
  202.             SeditComposedKey %%W "%A" "%%A"
  203.         }
  204.         }
  205.     }
  206.     }
  207.  
  208.     SeditBind $tclass seldelete {
  209.     Text_KillSelection %W
  210.     SeditDirty %W
  211.     }
  212.     SeditBind Entry seldelete {
  213.     catch {%W delete sel.first sel.last}
  214.     }
  215.  
  216.     SeditBind $tclass backspace {
  217.     if ![SeditKill?Sel %W] {
  218.         Text_Delete %W insert-1c insert
  219.     }
  220.     %W yview -pickplace insert
  221.     SeditDirty %W
  222.     }
  223.     SeditBind Entry backspace {
  224.     tkEntryBackspace %W
  225.     }
  226.  
  227.     SeditBind $tclass openline {
  228.     Text_Insert %W insert \n
  229.     Text_MoveInsert %W insert-1c
  230.     SeditDirty %W
  231.     }
  232.     SeditBind Entry openline { info library }
  233.  
  234.     SeditBind $tclass deleol {
  235.     if {! [SeditKill?Sel %W]} {
  236.         if {[%W index insert] == [%W index {insert lineend}]} {
  237.         Text_Delete %W insert insert+1c 1
  238.         } else {
  239.         Text_Delete %W insert "insert lineend" 1
  240.         }
  241.     }
  242.     %W yview -pickplace insert
  243.     SeditDirty %W
  244.     }
  245.     SeditBind Entry deleol {
  246.     %W delete insert end
  247.     }
  248.  
  249.     SeditBind $tclass delbol {
  250.     if {! [SeditKill?Sel %W]} {
  251.         if {[%W index insert] == [%W index {insert linestart}]} {
  252.         Text_Delete %W insert-1c insert 1
  253.         } else {
  254.         Text_Delete %W "insert linestart" insert 1
  255.         }
  256.     }
  257.     %W yview -pickplace insert
  258.     SeditDirty %W
  259.     }
  260.     SeditBind Entry delbol {
  261.     %W delete 0 insert
  262.     }
  263.  
  264.     SeditBind $tclass delwordforw {
  265.     if {! [SeditKill?Sel %W]} {
  266.         Text_Delete %W insert [Text_NextWord %W insert] 1
  267.     }
  268.     SeditDirty %W
  269.     }
  270.     SeditBind Entry delwordforw { }
  271.  
  272.     SeditBind $tclass delwordback {
  273.     if {! [SeditKill?Sel %W]} {
  274.         Text_Delete %W [Text_PrevWord %W insert] insert 1
  275.     }
  276.     %W yview -pickplace insert
  277.     SeditDirty %W
  278.     }
  279.     SeditBind Entry delwordback {
  280.     %W delete [string wordstart [%W get] [expr [%W index insert] - 1]] \
  281.         insert
  282.     tkEntrySeeInsert %W
  283.     }
  284.  
  285.     SeditBind $tclass delchar {
  286.     if {! [SeditKill?Sel %W]} {
  287.         Text_Delete %W insert
  288.     }
  289.     %W yview -pickplace insert
  290.     SeditDirty %W
  291.     }
  292.     SeditBind Entry delchar {
  293.     %W delete insert
  294.     }
  295.  
  296.     SeditBind $tclass transpose {
  297.     Text_TransposeChars %W
  298.     SeditDirty %W
  299.     }
  300.     SeditBind $tclass transemacs {
  301.     Text_TransposeCharsEmacs %W
  302.     SeditDirty %W
  303.     }
  304.     SeditBind Entry transpose {
  305.     SeditEntryTranspose %W 
  306.     }
  307.     SeditBind Entry transemacs {
  308.     SeditEntryTranspose %W emacs
  309.     }
  310.  
  311.     SeditBind $tclass transword {
  312.     Text_TransposeWords %W
  313.     SeditDirty %W
  314.     }
  315.     SeditBind Entry transword {
  316.     }
  317.  
  318.     # Motion bindings
  319.     SeditBind $tclass bof {
  320.     Text_MoveInsert %W 1.0
  321.     }
  322.     SeditBind Entry bof { }
  323.  
  324.     SeditBind $tclass eof {
  325.     Text_MoveInsert %W end
  326.     }
  327.     SeditBind Entry eof { }
  328.  
  329.     SeditBind $tclass linestart {
  330.     Text_MoveToBOL %W
  331.     }
  332.     SeditBind Entry linestart {
  333.     %W icursor 0
  334.     tkEntrySeeInsert %W
  335.    }
  336.  
  337.     SeditBind $tclass lineend {
  338.     Text_MoveInsert %W "insert lineend"
  339.     }
  340.     SeditBind Entry lineend {
  341.     %W icursor end
  342.     tkEntrySeeInsert %W
  343.     }
  344.  
  345.     set sedit(lastpos,Text) {}
  346.     SeditBind $tclass up1line {
  347.     Text_MoveInsert %W insert-1line
  348.     }
  349.     SeditBind Entry up1line { }
  350.  
  351.     SeditBind $tclass down1line {
  352.     Text_MoveInsert %W insert+1line
  353.     }
  354.     SeditBind Entry down1line { }
  355.  
  356.     SeditBind $tclass backword {
  357.     Text_MoveInsert %W [Text_PrevWord %W insert]
  358.     }
  359.     SeditBind Entry backword {
  360.     set string [%W get]
  361.     set curs [expr [%W index insert]-1]
  362.     if {$curs < 0} return
  363.     for {set x $curs} {$x > 0} {incr x -1} {
  364.         if {([string first [string index $string $x] " \t"] < 0)
  365.             && ([string first [string index $string [expr $x-1]] " \t"]
  366.             >= 0)} {
  367.         break
  368.         }
  369.     }
  370.     %W icursor $x
  371.     tkEntrySeeInsert %W
  372.     }
  373.  
  374.     SeditBind $tclass forwword {
  375.     Text_MoveInsert %W [Text_NextWord %W insert]
  376.     }
  377.     SeditBind Entry forwword {
  378.     set string [%W get]
  379.     set curs [expr [%W index insert]+1]
  380.     set len [string length $string]
  381.     if {$curs < 0} return
  382.     for {set x $curs} {$x < $len} {incr x} {
  383.         if {([string first [string index $string $x] " \t"] < 0)
  384.             && ([string first [string index $string [expr $x+1]] " \t"]
  385.             >= 0)} {
  386.         break
  387.         }
  388.     }
  389.     %W icursor $x    
  390.     tkEntrySeeInsert %W
  391.     }
  392.  
  393.     SeditBind $tclass backchar {
  394.     Text_MoveInsert %W insert-1c
  395.     }
  396.     SeditBind Entry backchar {
  397.     set x [%W index insert]
  398.     if {$x > 0} {
  399.         incr x -1
  400.         %W icursor $x
  401.         tkEntrySeeInsert %W
  402.     }
  403.     }
  404.  
  405.     SeditBind $tclass forwchar {
  406.     Text_MoveInsert %W insert+1c
  407.     }
  408.     SeditBind Entry forwchar {
  409.     set x [%W index insert]
  410.     incr x
  411.     %W icursor $x
  412.     tkEntrySeeInsert %W
  413.     }
  414.  
  415.     SeditBind $tclass up1page {
  416.     Widget_TextPageUp %W
  417.     }
  418.     SeditBind Entry up1page { } ;# no-op
  419.  
  420.     SeditBind $tclass down1page {
  421.     Widget_TextPageDown %W
  422.     }
  423.     SeditBind Entry down1page { } ;# no-op
  424.  
  425.     bind $tclass <Any-Key> { SeditInsert %W %A }
  426.     bind $tclass <Mod2-Key> { SeditInsert %W %A }
  427.  
  428.     if {[info commands kinput_start] == "kinput_start"} {
  429.     bind $tclass <Control-backslash> {SeditKinput_start %W}
  430.     bind $tclass <Control-Kanji> {SeditKinput_start %W}
  431.     bind $tclass <Control-Shift_R> {SeditKinput_start %W}
  432.     }
  433.  
  434.     SeditBind SeditText addrexpand {Addr_KeyExpand %W}
  435.     SeditBind SeditText format {Sedit_FormatParagraph %W}
  436.  
  437.     foreach cmd [info commands Hook_TextBind*] {
  438.     $cmd $tclass
  439.     }
  440.  
  441.     # Selection bindings
  442.     set tclass TSelect
  443.     SeditBind $tclass selcopy {
  444.     catch {clipboard clear ; clipboard append [Text_Selection]}
  445.     cutbuffer set [Text_Selection]
  446.     }
  447.     SeditBind Entry selcopy {
  448.     catch {clipboard clear ; clipboard append [Text_Selection]}
  449.     cutbuffer set [Text_Selection]
  450.     }
  451.  
  452.     SeditBind $tclass selclear { Text_LoseSelection %W }
  453.     SeditBind Entry selclear { %W select clear }
  454.  
  455.     SeditBind $tclass selstart {
  456.     Text_LoseSelection %W; WidgetTextSelStart %W insert char
  457.     }
  458.     SeditBind Entry selstart {
  459.     %W select clear ; %W select from insert
  460.     }
  461.  
  462.     SeditBind $tclass selforw {
  463.     Text_SelectTo %W insert
  464.     Text_SelectionEnd %W 1
  465.     }
  466.     SeditBind Entry selforw {
  467.     set x [%W index insert]
  468.     incr x
  469.     %W icursor $x
  470.     %W select to insert
  471.     }
  472.  
  473.     SeditBind $tclass selback {
  474.     Text_SelectTo %W insert
  475.     Text_SelectionEnd %W 1
  476.     }
  477.     SeditBind Entry selback {
  478.     set x [%W index insert]
  479.     incr x -1
  480.     %W icursor $x
  481.     %W select to insert
  482.     }
  483.  
  484.     SeditBind $tclass selextend {
  485.     Text_SelectTo %W insert
  486.     Text_SelectionEnd %W 1
  487.     Text_SelectionEnd %W 1
  488.     }
  489.     SeditBind Entry selextend {
  490.     %W select to insert
  491.     }
  492.     SeditBind $tclass highlight {
  493.     SeditBeautify %W
  494.     }
  495.  
  496.     bind $tclass <Button-1>        {WidgetTextSelBegin %W %x %y char}
  497.     bind $tclass <Double-Button-1>    {WidgetTextSelBegin %W %x %y word}
  498.     bind $tclass <Triple-Button-1>    {WidgetTextSelBegin %W %x %y line}
  499.     bind $tclass <B1-Motion>        {WidgetTextSelMotion %W %x %y}
  500.     bind $tclass <ButtonRelease-1>    {WidgetTextSelDone %W}
  501.     bind $tclass <Shift-Button-1>    {WidgetTextSelAgain %W %x %y}
  502.     bind $tclass <Shift-B1-Motion>    {WidgetTextSelMotion %W %x %y}
  503.     bind $tclass <Shift-ButtonRelease-1>    {WidgetTextSelDone %W}
  504.     bind $tclass <Control-Button-1>    {Text_MoveInsert %W @%x,%y noclear}
  505.  
  506.     bind Entry <Any-Key>    {SeditEntryInsert %W %A}
  507.     bind Entry <Mod2-Key>    {SeditEntryInsert %W %A}
  508.  
  509.     bind Entry <Button-1>     {SeditEntrySelect %W %x}
  510.     bind Entry <Shift-Button-1> {SeditEntryShiftSelect %W %x}
  511.     bind Entry <B1-Motion>    {SeditEntryDrag %W %x}
  512.     bind Entry <Shift-B1-Motion> {SeditEntryDrag %W %x}
  513.     bind Entry <Double-Button-1> {SeditEntryWordSelect %W %x}
  514.     bind Entry <Triple-Button-1> {SeditEntryLineSelect %W %x}
  515.  
  516.     # Hack.  This has been here all the time as part of the default
  517.     # entry class bindings.  Should be settable though.
  518.     bind Entry <Control-u>    {%W delete 0 end}
  519.  
  520.     # Scroll bindings
  521.     set tclass TScroll
  522.  
  523.     # Clear default scroll bindings
  524.     foreach seq {<Button-2> <B2-Motion>} {
  525.     bind $tclass $seq {}
  526.     bind Entry $seq {}
  527.     }
  528.  
  529.     global exwin
  530.     switch -- $sedit(scrollButton) {
  531.     Middle { set b 2 }
  532.     Right { set b 3 }
  533.     ShiftMiddle { set b shift2 }
  534.     None { set b {} }
  535.     }
  536.     # focus debug hack
  537.     if {([info command log_dump] == "log_dump")} {
  538.     bind $tclass <Double-Escape> {
  539.         if [catch {
  540.         if ![info exists logID] {set logID 0}
  541.         while {[file exists /tmp/log$logID]} {
  542.             incr logID
  543.         }
  544.         log SEDIT "/tmp/log$logID"
  545.         set out [open /tmp/log$logID w]
  546.         puts $out [log_dump]
  547.         close $out
  548.         Exmh_Status "Debug log in /tmp/log$logID"
  549.         incr logID
  550.         } err] {
  551.         Exmh_Status $err
  552.         }
  553.     }
  554.     }
  555.     if {$b == 2 || $b == 3} {
  556.     bind $tclass <Button-$b> {
  557.         WidgetTextMark %W %y
  558.     }
  559.     bind $tclass <B$b-Motion> {
  560.         WidgetTextDragto %W %y $exwin(scrollSpeed)
  561.     }
  562.     bind $tclass <Shift-Button-$b> {
  563.         WidgetTextMark %W %y
  564.         set widgetText(%W,paste?) 0
  565.     }
  566.     bind $tclass <Shift-B$b-Motion> {
  567.         WidgetTextDragto %W %y [expr $exwin(scrollAccel)*$exwin(scrollSpeed)]
  568.     }
  569.  
  570.     bind Entry <Button-$b>        {%W scan mark %x}
  571.     bind Entry <B$b-Motion>        {%W scan dragto %x}
  572.     } elseif {$b == "shift2"} {
  573.     set b 2
  574.     bind $tclass <Shift-Button-$b>     {WidgetTextMark %W %y}
  575.     bind $tclass <Shift-B$b-Motion>     \
  576.         {WidgetTextDragto %W %y $exwin(scrollSpeed)}
  577.  
  578.     bind Entry <Shift-Button-$b>        {%W scan mark %x}
  579.     bind Entry <Shift-B$b-Motion>        {%W scan dragto %x}
  580.     }
  581.     bind $tclass <Button-2> {+
  582.     set widgetText(%W,time) %t
  583.     set widgetText(%W,paste?) 1
  584.     set widgetText(%W,x) %x
  585.     set widgetText(%W,y) %y
  586.     }
  587.     bind $tclass <ButtonRelease-2> {
  588.     if [info exists widgetText(%W,paste?)] {
  589.         if {$widgetText(%W,paste?) &&
  590.         (%t - $widgetText(%W,time)) < 500 &&
  591.         (abs(%x - $widgetText(%W,x)) < 3) &&
  592.         (abs(%y - $widgetText(%W,y)) < 3)} {
  593.         catch {
  594.             if $sedit(pasteSetsInsert) {
  595.             Text_MoveInsert %W @%x,%y noclear
  596.             }
  597.             Text_Yank %W
  598.             SeditDirty %W
  599.         }
  600.         }
  601.     }
  602.     }
  603.     bind Entry <Button-2> {+
  604.     set widgetText(%W,time) %t
  605.     set widgetText(%W,paste?) 1
  606.     set widgetText(%W,x) %x
  607.     set widgetText(%W,y) %y
  608.     }
  609.     bind Entry <ButtonRelease-2> {
  610.     if [info exists widgetText(%W,paste?)] {
  611.         if {$widgetText(%W,paste?) &&
  612.         (%t - $widgetText(%W,time)) < 500 &&
  613.         (abs(%x - $widgetText(%W,x)) < 3) &&
  614.         (abs(%y - $widgetText(%W,y)) < 3)} {
  615.         if [catch {
  616.             %W insert insert [selection get]
  617.         }] {
  618.             if [catch {%W insert insert [cutbuffer get]}] {
  619.     #        catch {%W insert insert $sedit(killbuf)}
  620.             }
  621.         }
  622.         }
  623.     }
  624.     }
  625. }
  626. proc SeditEntryInsert { w a } {
  627.     global sedit
  628.     if {$a != ""} {
  629.     if {$sedit(typeKillsSel)} {
  630.         catch {$w delete sel.first sel.last}
  631.     }
  632.     $w insert insert $a
  633.     tkEntrySeeInsert $w
  634.     }
  635. }
  636. proc SeditEntrySelect { w x } {
  637.     global sedit
  638.     set sedit(selectmode,$w) char
  639.     $w icursor @$x
  640.     $w select from @$x
  641.     set sedit(anchor,$w) [$w index @$x]
  642.     if {[lindex [$w config -state] 4] == "normal"} {focus $w}
  643. }
  644. proc SeditEntryShiftSelect { w x } {
  645.     global sedit
  646.     if ![info exists sedit(selectmode,$w)] {
  647.     return
  648.     }
  649.     if {$sedit(selectmode,$w) == "word"} {
  650.     set nx [$w index @$x]
  651.     set ix [SeditEntryFindWord $w $x [expr {$nx >= $sedit(anchor,$w)}]]
  652.     } else {
  653.     set ix [$w index @$x]
  654.     }
  655.     $w select adjust $ix
  656. }
  657. proc SeditEntryDrag { w x } {
  658.     global sedit
  659.     if ![info exists sedit(selectmode,$w)] {
  660.     return
  661.     }
  662.     if {$sedit(selectmode,$w) == "word"} {
  663.     set nx [$w index @$x]
  664.     set ix [SeditEntryFindWord $w $x [expr {$nx >= $sedit(anchor,$w)}]]
  665.     } else {
  666.     set ix [$w index @$x]
  667.     }
  668.     $w select to $ix
  669. }
  670. proc SeditEntryWordSelect { w x } {
  671.     global sedit
  672.     set sedit(selectmode,$w) word
  673.     set ix [SeditEntryFindWord $w $x 0]
  674.     $w select from $ix
  675.     $w icursor $ix
  676.     tkEntrySeeInsert $w
  677.     $w select to [SeditEntryFindWord $w $x 1]
  678.     set sedit(anchor,$w) $ix
  679. }
  680. proc SeditEntryFindWord { w x {forw 1} } {
  681.     set string [$w get]
  682.     set ix [$w index @$x]
  683.     set start 1
  684.     set char [string index $string $ix]
  685.     if {$forw} {
  686.     while {[string length $char] && ![regexp {[     ]} $char]} {
  687.         incr ix
  688.         set char [string index $string $ix]
  689.         set start 0
  690.     }
  691.     } else {
  692.     while {[string length $char] && ![regexp {[     ]} $char]} {
  693.         incr ix -1
  694.         set char [string index $string $ix]
  695.         set start 0
  696.     }
  697.    }
  698.    if {! $start} {
  699.        if {$forw} {
  700.        incr ix -1
  701.        } else {
  702.        incr ix 1
  703.        }
  704.    }
  705.    return $ix
  706. }
  707. proc SeditEntryLineSelect { w x } {
  708.     global sedit
  709.     set sedit(selectmode,$w) char    ;# yes, char
  710.     $w select from 0
  711.     $w select to end
  712.     $w icursor 0
  713.     tkEntrySeeInsert $w
  714. }
  715. proc SeditEntryTranspose { w {how ""} } {
  716.     set _x [$w index insert]
  717.     if {$how == "emacs"} {
  718.     # Transpose two characters around insert and advance insert
  719.     incr _x -1
  720.     if {$_x < 0} {set _x 0}
  721.     set _c [string index [$w get] $_x]
  722.     $w delete $_x
  723.     $w icursor [expr [$w index insert] +1]
  724.     $w insert insert $_c
  725.     } else {
  726.     # Transpose two characters before insert
  727.     incr _x -2
  728.     if {$_x < 0} {set _x 0}
  729.     set _c [string index [$w get] $_x]
  730.     $w delete $_x
  731.     incr _x
  732.     $w insert $_x $_c
  733.     }
  734.     tkEntrySeeInsert $w
  735. }
  736.  
  737. proc SeditKill?Sel { w } {
  738.     global sedit
  739.     if $sedit(typeKillsSel) {
  740.     return [Text_KillSelection $w]
  741.     } else {
  742.     return 0
  743.     }
  744. }
  745. proc SeditInsert { w a } {
  746.     global sedit
  747.  
  748.     if {"X$a" != "X"} {
  749.     if $sedit(typeKillsSel) {
  750.         Text_KillSelection $w
  751.     }
  752.     scan $a %c X
  753.     if {$X > 127} {
  754.         set sedit($w,8bit) 1
  755.     }
  756.     if {[string compare $sedit($w,format) "OnType"] == 0} {
  757.         set i [SeditCount $w insert]
  758.         if {$i >= $sedit(lineLength)} {
  759.         if [$w compare insert <= hlimit] {
  760.             set stuff "\n "
  761.         } else {
  762.             set stuff \n
  763.         }
  764.         if [catch {$w insert wordbreak $stuff}] {
  765.             $w insert insert $stuff
  766.         }
  767.         $w mark unset wordbreak
  768.         }
  769.         $w insert insert $a
  770.         if [regexp $sedit(wordbreakpat) $a] {
  771.         $w mark set wordbreak insert
  772.         $w mark gravity wordbreak left
  773.         }
  774.     } else {
  775.         $w insert insert $a
  776.     }
  777.     $w yview -pickplace insert
  778.     set sedit($w,dirty) 1
  779.     }
  780. }
  781. proc SeditCount {w mark} {
  782.     set string [$w get "$mark linestart" $mark]
  783.     set i 0
  784.     foreach c [split $string {}] {
  785.     if {"$c" == "\t"} {
  786.         set i [expr $i/8 + 8]
  787.     } else {
  788.         incr i
  789.     }
  790.     }
  791.     return $i
  792. }
  793. proc SeditMarkClean { t } {
  794.     global sedit
  795.     set sedit($t,dirty) 0
  796. }
  797. proc SeditDirty { t } {
  798.     global sedit
  799.     set sedit($t,dirty) 1
  800. }
  801. proc SeditIsDirty { t } {
  802.     global sedit
  803.     return $sedit($t,dirty)
  804. }
  805.  
  806. proc Sedit_Pref {} {
  807.     global sedit
  808.     if [Exwin_Toplevel .seditpref "Simple Edit Preferences" Pref] {
  809.     Widget_AddBut .seditpref.but save "Save" {SeditPrefSave}
  810.     Widget_AddBut .seditpref.but help "Help" {SeditPrefHelp}
  811.     Widget_AddBut .seditpref.but event "Events" {SeditEventHelp}
  812.     Widget_Label .seditpref.but label {left fill} \
  813.         -text "Text and Entry class bindings"
  814.  
  815.  
  816.     set f2 [Widget_Frame .seditpref tog]
  817.     pack $f2 -padx 10 -pady 4 -fill none
  818.     $f2 configure -bd 2
  819.     Widget_Label $f2 label {left padx 10} -text "Options"
  820.     Widget_CheckBut $f2 type "Type Kills SEL" sedit(typeKillsSel) {left padx 4}
  821.     Widget_CheckBut $f2 paste "Paste Sets Insert" sedit(pasteSetsInsert) {left padx 4}
  822.     set f2 [Widget_Frame .seditpref tog2 Frame {top expand fillx padx 10 pady 4}]
  823.     $f2 configure -bd 2
  824.     pack $f2 -padx 10 -pady 4 -fill none
  825.     Widget_Label $f2 label {left padx 10} -text "Scroll Button"
  826.     Widget_RadioBut $f2 but2 "Middle" sedit(scrollButton) {left padx 4}
  827.     Widget_RadioBut $f2 but3 "Right" sedit(scrollButton) {left padx 4}
  828.     Widget_RadioBut $f2 shift2 "Shift-Middle" sedit(scrollButton) {left padx 4}
  829.     Widget_RadioBut $f2 none "None" sedit(scrollButton) {left padx 4}
  830.  
  831.     set f [Widget_Frame .seditpref p Dialog]
  832.     $f configure -bd 10
  833.     set lr [Widget_SplitFrame $f Left Right]
  834.     set left [lindex $lr 0]
  835.     set right [lindex $lr 1]
  836.     set width 0
  837.     foreach item [array names sedit] {
  838.         if [regexp ^key $item] {
  839.         set name [lindex [split $item ,] 1]
  840.         set w [string length $name]
  841.         if {$w > $width} { set width $w }
  842.         }
  843.     }
  844.     set size 0
  845.     if [info exists sedit(key,delword)] {
  846.         lappend sedit(key,delwordforw) $sedit(key,delword)
  847.         unset sedit(key,delword)
  848.     }
  849.     foreach item [lsort [array names sedit]] {
  850.         if [regexp ^key $item] {
  851.         set name [lindex [split $item ,] 1]
  852.         incr size
  853.         set keystroke $sedit($item)
  854.         set frame [lindex $lr [expr {$size % 2}]]
  855.         SeditPrefItem $frame $width $name $keystroke
  856.         }
  857.     }
  858.     }
  859. }
  860. proc SeditPrefItem { frame width name keystroke } {
  861.     global sedit
  862.     Widget_Frame $frame $name Preference
  863.     Widget_Label $frame.$name label {left} -text $name -width $width
  864.     Widget_Entry $frame.$name entry {right expand fill}
  865.     set sedit(entry,$name) $frame.$name.entry
  866.     $frame.$name.entry insert 0 $keystroke
  867. }
  868. proc SeditPrefHelp {} {
  869.     Help Seditpref "Simple Edit Bindings Help"
  870. }
  871. proc SeditPrefSave { } {
  872.     global sedit
  873.     # Save it
  874.     set out [open $sedit(dotfile) w]
  875.     foreach item [array names sedit] {
  876.     if [regexp ^key $item match] {
  877.         set name [lindex [split $item ,] 1]
  878.         set entry $sedit(entry,$name)
  879.         set keystrokes [$entry get]
  880.         puts $out [list set sedit($match,$name) $keystrokes]
  881.     }
  882.     }
  883.     puts $out "set sedit(pasteSetsInsert) $sedit(pasteSetsInsert)"
  884.     puts $out "set sedit(typeKillsSel) $sedit(typeKillsSel)"
  885.     puts $out "set sedit(scrollButton) $sedit(scrollButton)"
  886.     close $out
  887.     Exwin_Dismiss .seditpref
  888.     # Apply it to current session
  889.     SeditReadPref
  890.     Sedit_ClassBindings
  891. }
  892. proc SeditKinput_start { w } {
  893.     global sedit
  894.  
  895. # modified by k.furukawa, jan.1995.  for automatic iso-2022-jp detection.
  896. # sedit($window, Acharset) is initialized with {} in Sedit_Start.
  897. # once kinput2 is used, the message header will have "charset=iso-2022-jp"
  898. # if you set "on" for "specify charset ..." in sedit preference.
  899.  
  900.     if [catch {kinput_start $w over} msg] {
  901.     Exmh_Status "kinput2 failed: $msg"
  902.     return
  903.     }
  904.     set sedit($w,Acharset) iso-2022-jp
  905. }
  906.  
  907. proc SeditEventHelp {} {
  908.     set t .seditevent.text
  909.     if [Exwin_Toplevel .seditevent "Event Helper" Pref] {
  910.     Widget_SimpleText .seditevent text {expand fill} -width 40 -height 10
  911.     bind $t <Key> {SeditEventFeedback %W %K %A ; break}
  912.     }
  913.     $t delete 1.0 end
  914.     $t insert 1.0 "Type into this window to see what events\nare generated by your keyboard\n***\n"
  915. }
  916. proc SeditEventFeedback {t keysym char} {
  917.     $t insert end "Keysym $keysym "
  918.     if {[string length $char] == 0} {
  919.     switch -glob -- $keysym {
  920.         Control* {set mod Control}
  921.         Alt* {set mod Meta}
  922.         Shift* {set mod Shift}
  923.     }
  924.     if [info exists mod] {
  925.         $t insert end "Modifier $mod"
  926.     }
  927.     $t insert end \n
  928.     } else {
  929.     $t insert end "Char \"$char\"\n"
  930.     }
  931.     $t yview -pickplace end
  932. }
  933.